vignettes/02-ejemplo estimación.R

In igutierrezm/mypkgr: Diccionario de variables del OLN

# Housekeeping
cat("\014")
rm(list = ls())

# Librerías externas
library(survey)
library(tidyverse)

# Carga el df de prueba
df_svy <- readRDS("vignettes/df1.rds")

# Argumentos
args <-
  list(formula = ~x2,
       FUN     = svymean,
       subpop  = TRUE,
       by      = ~x1,
       years   = 2016:2016,
       db      = 1,
       months  = 1:1)

# La función madre
oln_table_create <- function(design, args) {
  # Realiza la estimación
  args$design <- design
  df <- do.call(svyby, args)
}




# # Función general (funciona dado un df + una especificación)
# oln_estimate <- function(design, args) {
#   # Realiza la estimación
#   df <-
#     svyby(args$formula,
#           args$by,
#           args$FUN,
#           design = subset(design, args$subpop),
#           na.rm             = TRUE,
#           drop.empty.groups = FALSE)
# }

# Ordena los resultados  de oln_estimate
oln_ftable <- function(df, args) {
  # Convierte args$formula en character
  fm <- as.character(args$formula)[2]

  # Deduce las variables asociadas al bh
  nm_bh <- attr(df, "svyby")$variables
  n <- length(nm_bh)

  # Deduce las variables asociadas al se y a los dominios
  if (n == 1) nm_se <- "se"
  if (n >= 2) nm_se <- sprintf("se.%s", nm_bh)
  nm_over <- names(df) %>% setdiff(nm_bh) %>% setdiff(nm_se)

  # Divide df en dos bloques
  df_bh <- select(df, one_of(c(nm_over, nm_bh)))
  df_se <- select(df, one_of(c(nm_over, nm_se)))

  # Lo que sigue solo tiene sentido si n > 1
  if (n > 1) {
    # Ordena los resultados de cada bloque
    df_bh <- gather_(df_bh, fm, "bh", nm_bh, factor_key = TRUE)
    df_se <- gather_(df_se, fm, "se", nm_se, factor_key = TRUE)

    # Ajusta las etiquetas de key
    labs_bh <- df_bh[[fm]] %>% levels() %>% substring(nchar(fm) + 1)
    labs_se <- df_se[[fm]] %>% levels() %>% substring(nchar(fm) + 4)
    df_bh[[fm]] <- factor(df_bh[[fm]], labels = labs_bh)
    df_se[[fm]] <- factor(df_se[[fm]], labels = labs_se)
  }

  # Combina las BBDD
  df <- inner_join(df_bh, df_se)

  # Presenta los resultados
  return(df)
}


# Estimación
# means <- oln_estimate(df_svy, args)
# tbl   <- oln_ftable(means, args)
means <- oln_table_create(df_svy, args)
print(means)